home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / WINDOWS / PPW1.ARJ / SUBS.WAS < prev    next >
Text File  |  1992-06-18  |  60KB  |  1,491 lines
  1. ;Host Mode v1.00a include file - Do not compile!
  2.  
  3. ;***********************************************************************
  4. ;*                                                                     *   
  5. ;* SUBS.WAS                                                            *
  6. ;* Copyright (C) 1992 Datastorm Technologies, Inc.                     *     
  7. ;* All rights reserverd.                                               * 
  8. ;*                                                                     * 
  9. ;* Purpose: Contains most of the lower level com and file I/O          *
  10. ;*          routines for Host Mode.                                    *
  11. ;*                                                                     * 
  12. ;***********************************************************************
  13.  
  14. ;***********************************************************************
  15. ;*                                                                     *
  16. ;*  WARNING!!!!                                                        *
  17. ;*                                                                     *
  18. ;*  Do not modify this script file unless you have a good under-       *
  19. ;*  standing of the Windows ASPECT language.  If you do modify this    *
  20. ;*  script, PLEASE MAKE A BACKUP before doing so.                      *
  21. ;*                                                                     *
  22. ;***********************************************************************
  23.  
  24. ;***********************************************************************
  25. ;*                                                                     *
  26. ;* HOSTSETUP                                                           *
  27. ;*                                                                     *
  28. ;* The procedure opens the HOST.PRM file and reads in variables.       *
  29. ;* Also sets up the paths for the mail files.                          *
  30. ;*                                                                     *
  31. ;* Calls: HOSTMSGBOX,   CHECKMENU                                      *
  32. ;*                                                                     *
  33. ;* Called by: MAIN                                                     *
  34. ;*                                                                     *
  35. ;* Modifies globals: sysop, local_logon, parmfile, hdrfile, msgfile,   *
  36. ;*                   logfile, usrfile, welcome_msg, upload_path,       *
  37. ;*                   dnload_path, new_usr_leve, connect_type,          *
  38. ;*                   system_type, goodbye_option, old_menu, new_menu   *
  39. ;*                                                                     *
  40. ;***********************************************************************
  41. proc HostSetup
  42.     
  43.    sysop=0
  44.    local_logon=0
  45.  
  46.    set aspect spawn on
  47.  
  48.    fetch aspect scriptpath parmfile
  49.    addfilename parmfile HOSTPRMFILE
  50.         
  51.    fetch aspect scriptpath hdrfile
  52.    addfilename hdrfile HOSTHDRFILE
  53.     
  54.    fetch aspect scriptpath msgfile
  55.    addfilename msgfile HOSTMSGFILE
  56.     
  57.    fetch aspect scriptpath logfile
  58.    addfilename logfile HOSTLOGFILE
  59.  
  60.    fetch aspect scriptpath usrfile
  61.    addfilename usrfile HOSTUSRFILE
  62.  
  63.    fetch aspect scriptpath newsfile
  64.    addfilename newsfile HOSTNWSFILE
  65.  
  66.    fetch aspect scriptpath nufile
  67.    addfilename nufile HOSTNUFILE
  68.  
  69.    fetch aspect scriptpath dnldfile
  70.    addfilename dnldfile HOSTDNLDFILE
  71.  
  72.    fetch aspect scriptpath nufile
  73.    addfilename nufile HOSTNUFILE
  74.  
  75.    fetch aspect scriptpath logfile
  76.    addfilename logfile HOSTLOGFILE
  77.  
  78.    fopen 0 parmfile READ TEXT
  79.    if not success
  80.       HostMsgBox("FATAL ERROR - Can't open HOST.PRM!")
  81.       halt
  82.    endif
  83.    fgets 0 welcome_msg
  84.    fgets 0 upload_path
  85.    fgets 0 dnload_path
  86.  
  87.    fgetc 0 new_usr_level
  88.       new_usr_level-=1
  89.       fgetc 0 connect_type
  90.       connect_type-=1
  91.       fgetc 0 system_type
  92.       system_type-=1
  93.       fgetc 0 goodbye_option
  94.       goodbye_option-=1
  95.    fclose 0
  96.  
  97.    save_prm()
  98.  
  99.    set aspect control off           ; turn off script button
  100.    set aspect keys on               ; we do all keys
  101.    set aspect rxdata on             ; we do all incoming data
  102.    set terminal enquiry off
  103.    set terminal statusline off
  104.    set viewgif no                   ; don't view GIF files
  105.  
  106.    set autodnld off                 ; Don't autodownload on host
  107.    set zmodem errdetect crc32       ; Use 32-bit CRC
  108.    set zmodem recvcrash protect     ; Don't let users overwrite files
  109.    set zmodem sendcrash negotiate   ; Let user recover his downloads
  110.    set zmodem timestamp off         ; Stamp files with system date/time
  111.    set zmodem txmethod streaming    ; Use fastest transmit method
  112.  
  113.    old_menu=$pwmenubar
  114.    menubar new_menu
  115.    menuitem new_menu 2 "&Disconnect user!"
  116.    showmenu new_menu
  117.    disable menu 2
  118.    showmenu new_menu
  119.    when menu call checkmenu
  120.    when userexit call ExitHost
  121. endproc
  122.  
  123. ;***********************************************************************
  124. ;*                                                                     *   
  125. ;* WAITFORCALL                                                         *
  126. ;*                                                                     *
  127. ;* This procedure waits for the modem's CD to go high and then gets    *
  128. ;* the connect message to set the baudrate.                            *
  129. ;*                                                                     * 
  130. ;* Calls: HOSTPUTS, EXITHOST                                           *
  131. ;*                                                                     *
  132. ;* Called by: MAIN                                                     *
  133. ;*                                                                     *
  134. ;* Modifies globals: connect_type, welcome_msg, tempkey, _time, _date, *
  135. ;*                   name, ontime, offtime, status, local_logon, sysop *
  136. ;*                                                                     *
  137. ;* Notes:  If connection is a direct connect it puts out the welcome   *
  138. ;*         message and returns.                                        *
  139. ;*                                                                     *
  140. ;***********************************************************************
  141. proc WaitForCall
  142. string c300, c1200, c2400, c4800, c9600, c19200, c38400, c57600
  143. string modemmsg=""
  144. integer char, index=0
  145. string init_string, auto_ans_on
  146. integer adjustbaud 
  147. long ltime
  148.  
  149.    fetch modem cnct300 c300
  150.    fetch modem cnct1200 c1200
  151.    fetch modem cnct2400 c2400
  152.    fetch modem cnct4800 c4800
  153.    fetch modem cnct9600 c9600
  154.    fetch modem cnct19200 c19200
  155.    fetch modem cnct38400 c38400
  156.    fetch modem cnct57600 c57600
  157.    fetch modem autobaud adjustbaud
  158.  
  159.    clear                               ; clear screen
  160.    if connect_type==DIRECT_CON         ; check for DIRECT connect
  161.       rxflush                          ; flush receive buffer
  162.       HostPutS("`r`n")
  163.       HostPutS(welcome_msg)            ; display welcome message
  164.       HostPutS("`r`n`r`n")
  165.       return
  166.    endif
  167.  
  168.    fetch modem autobaud adjustbaud     ; find out if modem's autobaud is on
  169.    fetch modem init init_string        ; get modem init string
  170.    fetch modem autoanson auto_ans_on   ; get modem auto answer string
  171.  
  172.    if $CARRIER                         ; if CD is high try to hangup
  173.       sdlgmsgbox "Host Message" "The modem is reporting `"ONLINE`".`n`nStart Host Mode script anyway?" STOP YESNO tempkey 2 beep
  174.       if tempkey==7
  175.          ExitHost()
  176.       endif
  177.    endif
  178.  
  179.    rxflush                             ; flush receive buffer
  180.   
  181.    set aspect rxdata on    ; aspect will process all incoming data        
  182.  
  183.  
  184.    if ! $CARRIER
  185.       dialogbox 42 25 200 70 14 "Host Mode"
  186.          text 13 25 166 8 center "Initializing Modem ...... Please Wait."
  187.       enddialog
  188.       set txpace 50
  189.       transmit "~^M~"
  190.       pause 2
  191.       txflush
  192.       rxflush
  193.       transmit init_string             ; initialize modem
  194.       if not waitfor "OK" 8
  195.          statmsg "Modem did not respond `"OK`" to initialize."
  196.       endif
  197.       pause 1
  198.       transmit auto_ans_on             ; put modem in autoanswer
  199.       if not waitfor "OK" 8
  200.          statmsg "Modem did not respond `"OK`" to auto answer command."
  201.       endif
  202.       set txpace 0
  203.       destroydlg                       ; get rid of dialog box
  204.  
  205.       _time=$TIME                      ; get current date and time
  206.       _date=$DATE
  207.  
  208.       strcmp name ""                   ; see if there was a
  209.       if success                       ; previous caller
  210.          name = "None"
  211.       endif
  212.  
  213.       dialogbox 48 4 162 172 14 "Host Mode - Waiting for call"
  214.          vtext 25 100 49 9 left _time
  215.          text  13 24 40 8 left "Last Caller: "
  216.          vtext 56 24 83 9 left name
  217.          vtext 82 100 42 9 left _date
  218.          groupbox 15 87 124 32 "Current" shadow
  219.          text  21 44 34 8 left "Online at: "
  220.          text  22 60 38 8 left "Offline at: "
  221.          vtext 76 44 39 9 left ontime
  222.          vtext 77 60 39 9 left offtime
  223.          pushbutton 16 135 54 14 "E&xit" update
  224.          pushbutton 80 135 54 14 "&Local Logon" update
  225.          groupbox 6 8 143 70 "Statistics" shadow
  226.       enddialog
  227.  
  228.       status=$DIALOG                   ; dialog box status
  229.       while 1
  230.          ltime=$LTIME
  231.          _time=$TIME
  232.          _date=$DATE
  233.  
  234.          if $carrier                   ; loop until CD goes high
  235.             exitwhile
  236.          endif
  237.  
  238.          switch status
  239.             case 30
  240.                ExitHost()
  241.             endcase
  242.  
  243.             case 31
  244.                local_logon=TRUE
  245.                connect_type=DIRECT_CON
  246.                sdlgmsgbox "Host Message" "Do you want to logon as SYSOP?" QUESTION YESNO tempkey 1 beep                
  247.                if tempkey==6
  248.                   sysop=TRUE 
  249.                endif    
  250.                HostPutS("`r`n`r`n")
  251.                HostPutS(welcome_msg)   ; display welcome message
  252.                HostPutS("`r`n")
  253.                destroydlg
  254.                return
  255.             endcase        
  256.          endswitch
  257.          status=$DIALOG
  258.         
  259.          if ltime<$LTIME               ; see if time has passed
  260.             updatedlg 64               ; if it has update the dialog box
  261.          endif
  262.       endwhile
  263.  
  264.       statmsg " "
  265.       destroydlg              ; remove dialog box
  266.    
  267.       if adjustbaud           ; if autobaud detect if on
  268.          while 1              ; loop and parse modem message 
  269.          
  270.             if ! $RXCOUNT     ; if there are no characters 
  271.                loopwhile      ; in the buffer then loop
  272.             endif
  273.       
  274.             comgetc char      ; get a characters
  275.       
  276.             if char==-1       ; if there is not a character
  277.                loopwhile      ; then loop
  278.             endif
  279.             
  280.             strpoke modemmsg index char  ; insert a character   
  281.             index++                      ; increment index
  282.       
  283.             if strfind modemmsg c300        ; search for connect messages
  284.                statmsg "CONNECT 300"        ; this is ugly, but there's no
  285.                set baudrate 300             ; other way to do it.
  286.                exitwhile                   
  287.             elseif strfind modemmsg c1200 
  288.                statmsg "CONNECT 1200"
  289.                set baudrate 1200
  290.                exitwhile
  291.             elseif strfind modemmsg c2400 
  292.                statmsg "CONNECT 2400"   
  293.                set baudrate 2400
  294.                exitwhile
  295.             elseif strfind modemmsg c4800 
  296.                statmsg "CONNECT 4800"   
  297.                set baudrate 4800
  298.                exitwhile
  299.             elseif strfind modemmsg c9600      
  300.                statmsg "CONNECT 9600"        
  301.                set baudrate 9600
  302.                exitwhile
  303.             elseif strfind modemmsg c19200     
  304.                statmsg "CONNECT 19200"
  305.                set baudrate 19200
  306.                exitwhile
  307.             elseif strfind modemmsg c38400 
  308.                statmsg "CONNECT 38400" 
  309.                set baudrate 38400
  310.                exitwhile
  311.             elseif strfind modemmsg c57600 
  312.                statmsg "CONNECT 57600" 
  313.                set baudrate 57600
  314.                exitwhile
  315.             endif  
  316.          endwhile
  317.       else
  318.          statmsg "Connected!"
  319.       endif      
  320.    endif
  321.    pause 1                    ; pause a moment, then flush the
  322.    rxflush                    ; buffers to remove any wierd modem
  323.    txflush                    ; message or handshake characters
  324.    HostPutS("`r`n`r`n")
  325.    HostPutS(welcome_msg)      ; display welcome message
  326.    HostPutS("`r`n")
  327. endproc
  328.  
  329. ;***********************************************************************
  330. ;*                                                                     *   
  331. ;* GETUSER                                                             *
  332. ;*                                                                     *
  333. ;* This procedure prompts a user to login.                             *
  334. ;*                                                                     *
  335. ;*                                                                     * 
  336. ;* Calls: XKEYGET, HOSTLOG, SETFAILURE, GETUSERNAME, GETUSERPSWD,      *
  337. ;*        PARSEUSRREC, SETSUCCESS                                      *
  338. ;*                                                                     *
  339. ;* Modifies globals: tempkey, connect_type, ontime                     *
  340. ;*                                                                     *
  341. ;***********************************************************************
  342. proc GetUser
  343.  
  344.    while 1
  345.       if $keyhit
  346.          XKeyGet(&tempkey)
  347.       endif
  348.  
  349.       if (! $carrier) && (connect_type==MODEM_CON)
  350.          HostLog("Lost Carrier", "")
  351.          SetFailure()
  352.          return
  353.       endif
  354.  
  355.       GetUserName()              ; Get the users name
  356.       if success
  357.          GetUserPswd()           ; Get the users password
  358.          if success
  359.             ParseUsrRec()        ; strfind and parse user record
  360.             if success           ; If found and parsed
  361.                time ontime       ; get current time
  362.                SetSuccess()
  363.                return
  364.             else
  365.                SetFailure()      ; Error getting user record
  366.                return
  367.             endif
  368.          else
  369.             SetFailure()         ; Error getting password
  370.             return
  371.          endif
  372.       else                       ; Error getting user name
  373.          SetFailure()
  374.          return
  375.       endif
  376.    endwhile
  377. endproc
  378.  
  379. ;***********************************************************************
  380. ;*                                                                     *   
  381. ;* GETUSERNAME                                                         *
  382. ;*                                                                     *
  383. ;* This procedure get the first and last name from the remote user.    *
  384. ;*                                                                     *
  385. ;*                                                                     * 
  386. ;* Calls: HOSTLOG, SETFAILURE, HOSTPUTS, HOSTGETS, HOSTGETYN,          *
  387. ;*        HOSTHANGUP                                                   *
  388. ;*                                                                     *
  389. ;* Modifies globals: connect_type, first, last, name                   *
  390. ;*                                                                     *
  391. ;***********************************************************************
  392. proc GetUserName
  393. integer i, len, tries
  394.  
  395.    tries = 0
  396.  
  397.    if (! $carrier) && (connect_type==MODEM_CON)
  398.       HostLog("Lost Carrier", "")
  399.       SetFailure()
  400.       return
  401.    endif
  402.  
  403.    pause 1
  404.    rxflush
  405.    while tries < 3
  406.       tries++
  407.       HostPutS("`r`n`r`nFirst name: ")
  408.       HostGetS(&first, NAMEMAX, DISP)  ; Get first (and optionally last)
  409.       if not success                   ; return FAILURE if CD drops
  410.          exitwhile
  411.       endif
  412.       strlen first len              ; len = length of first name
  413.       if len == 0                   ; If length is zero
  414.          loopwhile                  ;  go to top of loop
  415.       endif
  416.  
  417.       strfind first " " i           ; Is there a last name? (SPACE)
  418.       if not found
  419.          strfind first ";" i        ; (Look for SEMICOLON if no SPACE)
  420.       endif
  421.  
  422.       if found                      ; YES, there is a last name:
  423.          strpoke first i 0          ;   terminate the first name
  424.          i++                        ;   i -> 1st character in last name
  425.          substr last first i 80     ;    ulast is last name
  426.       else
  427.          HostPutS("`r`nLast name: ")
  428.          HostGetS(&last, NAMEMAX, DISP)     ; Get last name
  429.          if not success
  430.             exitwhile
  431.          endif
  432.  
  433.          strlen last len
  434.          if len == 0
  435.             loopwhile
  436.          endif
  437.       endif
  438.  
  439.       strupr first
  440.       strupr last
  441.       name = first
  442.       strcmp last ""
  443.       if not success
  444.          strcat name " "
  445.          strcat name last
  446.       endif
  447.       HostPutS("`r`n")
  448.       HostPutS(name)
  449.       HostPutS("`r`nIs this correct (Y/N)? ")
  450.       HostGetYN()
  451.       if success
  452.          return
  453.       else                          ; if user says NO
  454.          tries--                    ;   don't count it as a try
  455.       endif
  456.    endwhile
  457.    if connect_type==MODEM_CON
  458.       HostHangup()
  459.    endif
  460.    HostLog("unknown caller", "failed to enter name.")
  461.    SetFailure()
  462. endproc
  463.  
  464. ;***********************************************************************
  465. ;*                                                                     *   
  466. ;* GETUSERPSWD                                                         *
  467. ;*                                                                     *
  468. ;* This procedure get the users password.                              *
  469. ;*                                                                     *
  470. ;*                                                                     * 
  471. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETS, SETSUCCESS,         *
  472. ;*        HOSTHANGUP                                                   *
  473. ;*                                                                     *
  474. ;* Modifies globals: connect_type, passwrd, name                       *
  475. ;*                                                                     *
  476. ;***********************************************************************
  477. proc GetUserPswd
  478. integer i, tries
  479.  
  480.    tries = 0
  481.    HostPutS("`r`n")
  482.    while tries < 3
  483.       if (! $carrier) && (connect_type==MODEM_CON)
  484.          HostLog("Lost Carrier", "")
  485.          SetFailure()
  486.          return
  487.       endif
  488.  
  489.       HostPutS("`r`nPassword: ")
  490.       HostGetS(&passwrd, PSWDMAX, MASK)    ; Get passwrd
  491.       if not success
  492.          exitwhile
  493.       endif
  494.       strlen passwrd i
  495.       if i > 0
  496.          strupr passwrd
  497.          SetSuccess()
  498.          return
  499.       endif
  500.       tries++
  501.    endwhile
  502.    if connect_type==MODEM_CON
  503.       HostHangup()
  504.    endif
  505.    HostLog(name, "failed to enter password.")
  506.    SetFailure()
  507. endproc
  508.  
  509. ;***********************************************************************
  510. ;*                                                                     *   
  511. ;* HOSTGETS                                                            *
  512. ;*                                                                     *
  513. ;* This procedure gets a string from the remote user.                  *
  514. ;*                                                                     *
  515. ;*                                                                     * 
  516. ;* Calls: HOSTGETC, SETSUCCESS, HOSTPUTS                               *
  517. ;*                                                                     *
  518. ;* Modifies globals: none                                              *
  519. ;*                                                                     *
  520. ;***********************************************************************
  521. proc HostGetS
  522. strparm s
  523. intparm max, dodisp
  524. integer i
  525. string response
  526.  
  527.    strpoke s 0 0
  528.    i = 0
  529.    while 1
  530.       HostGetC(&response)
  531.       if not success
  532.          exitwhile
  533.       endif
  534.       switch response
  535.          case "`r"
  536.             SetSuccess()
  537.             exitwhile
  538.          endcase
  539.          case "`b"
  540.             if i != 0
  541.                HostPutS(response)
  542.                i--
  543.                strpoke s i 0
  544.             endif
  545.          endcase
  546.          case " "                   ; This SPACE case must immediately
  547.             if i == 0               ; precede the default so it will
  548.                loopwhile            ; fall through
  549.             endif
  550.          default
  551.             if i < max
  552.                if dodisp
  553.                   HostPutS(response)
  554.                else
  555.                   HostPutS("*")
  556.                endif
  557.                strcat s response
  558.                i++
  559.             endif
  560.          endcase
  561.       endswitch
  562.    endwhile
  563. endproc
  564.  
  565. ;***********************************************************************
  566. ;*                                                                     *
  567. ;* HOSTGETYN                                                           *
  568. ;*                                                                     *
  569. ;* This procedure get a Y or N from the remote user.                   *
  570. ;*                                                                     *
  571. ;*                                                                     * 
  572. ;* Calls: HOSTGETC, HOSTPUTS, SETSUCCESS, SETFAILURE                   *
  573. ;*                                                                     *
  574. ;* Modifies globals: none                                              *
  575. ;*                                                                     *
  576. ;***********************************************************************
  577. proc HostGetYN
  578. string response
  579.  
  580.    while 1
  581.       HostGetC(&response)
  582.       if not success
  583.          return
  584.       endif
  585.       strupr response
  586.       HostPutS(response)
  587.       switch response
  588.          case "Y"
  589.             SetSuccess()
  590.             return
  591.          endcase
  592.          case "N"
  593.          default
  594.             SetFailure()
  595.             return
  596.          endcase
  597.       endswitch
  598.    endwhile
  599. endproc
  600.  
  601. ;***********************************************************************
  602. ;*                                                                     *   
  603. ;* HOSTGETC                                                            *
  604. ;*                                                                     *
  605. ;* This procedure gets a character from the remote user.               *
  606. ;*                                                                     *
  607. ;*                                                                     * 
  608. ;* Calls: XKEYGET, HOSTLOG, SETFAILURE, SETSUCCESS                     *
  609. ;*                                                                     *
  610. ;* Modifies globals: local_logon, connect_type                         *
  611. ;*                                                                     *
  612. ;***********************************************************************
  613. proc HostGetC
  614. strparm c
  615. integer i = -1
  616.  
  617.    while i == -1
  618.       if $keyhit              ; If a key is pressed
  619.          XKeyGet(&i)          ;   get the key
  620.       endif
  621.       if !local_logon
  622.          if $RXDATA           ; If data available at port
  623.             comgetc i         ; get the next character
  624.          endif
  625.          if (! $carrier) && (connect_type==MODEM_CON)  ; If carrier drops
  626.             HostLog("Lost Carrier", "")
  627.             SetFailure()      ;    set error return code
  628.             return            ;    and return to caller
  629.          endif
  630.       endif
  631.    endwhile
  632.    strfmt c "%c" i
  633.    SetSuccess()
  634. endproc
  635.  
  636. ;***********************************************************************
  637. ;*                                                                     *   
  638. ;* HOSTPUTS                                                            *
  639. ;*                                                                     *
  640. ;* This procedure send a string to the remote user and displays it     *
  641. ;* in the terminal window.                                             *
  642. ;*                                                                     * 
  643. ;* Calls: NONE                                                         *
  644. ;*                                                                     *
  645. ;* Called by: EVERYTHING!! 168 times                                   *
  646. ;*                                                                     *
  647. ;* Modifies globals: local_logon                                       *
  648. ;*                                                                     *
  649. ;***********************************************************************
  650. proc HostPutS
  651. strparm s
  652.  
  653.    if !local_logon
  654.       transmit s        ; send the string to the remote user
  655.    endif
  656.    termwrites s         ; send the string to the local screen
  657. endproc
  658.  
  659. ;***********************************************************************
  660. ;*                                                                     *   
  661. ;* PARSEUSRREC                                                         *
  662. ;*                                                                     *
  663. ;* This procedure looks up a user in .USR file and parse record        *
  664. ;* into globals.                                                       *
  665. ;*                                                                     *
  666. ;*                                                                     * 
  667. ;* Calls: ADDUSER, COPYSFLD, SETSUCCESS, GETUSERPSWD,  HOSTPUTS,       *
  668. ;*        HOSTHANGUP, HOSTLOG, SETFAILURE, HOSTMSGBOX                  *
  669. ;*                                                                     *
  670. ;* Modifies globals: name, first, last, passwrd, usrfile, record,      *
  671. ;*                   access_level, remarks, connect_type, system_type  *
  672. ;*                                                                     *
  673. ;* NOTES:                                                              *
  674. ;*        access_level  - User's access level ("0", "1", or "2")       *
  675. ;*             comment  - User's comment field                         *
  676. ;*             first    - User's first name                            *
  677. ;*             last     - User's last name                             *
  678. ;*             name     - User's full name (first and last)            *
  679. ;*             passwrd  - User's password                              *
  680. ;*             record   - Raw record (terminated with a line feed)     *
  681. ;*                                                                     *
  682. ;*             HOSTS.USR record:                                       *
  683. ;*                                                                     *
  684. ;*                 lastname;firstname;passwrd;n;comment.......         *
  685. ;*                 (n is the access_level level {'0','1',or '2'})      *
  686. ;*                                                                     *
  687. ;***********************************************************************
  688. proc ParseUsrRec
  689. integer i, tries=1
  690. string tmp, tmp2
  691.  
  692.    strfind name " " i               ; i = index of blank name separator
  693.    if found
  694.       strcpy first name i           ; copy first name
  695.       i++                           ; i = index of last name
  696.       substr last name i 79         ; extract last name
  697.    endif
  698.    strfmt tmp "%s;%s" last first    ; 'tmp' is what we're looking for
  699.    strfmt tmp2 "%s;%s;%s" last first passwrd
  700.    strlen tmp i                     ; i = length of name part
  701.    isfile usrfile
  702.    if not success
  703.       AddUser()
  704.       return
  705.    else
  706.       fopen 1 usrfile READ TEXT     ; Try to open user file
  707.    endif
  708.    if success                       ; If opened
  709.       while not FEOF 1              ;    loop until end of file
  710.          fgets 1 record             ;       Get record
  711.          strupr record              ; upper case the record
  712.          strcmp record tmp i        ;       Scan record for user
  713.          if success                 ;       If this is our guy,
  714.             while tries<3
  715.                strlen tmp2 i
  716.                strcmp record tmp2 i
  717.                if success
  718.                   ; Copy password
  719.                   CopySFld(&passwrd, record, &i, FLD_SEP)      
  720.  
  721.                   ; Copy access level level
  722.                   CopySFld(&access_level, record, &i, FLD_SEP) 
  723.  
  724.                   ; Copy comment
  725.                   CopySFld(&remarks, record, &i, FLD_SEP)
  726.  
  727.                   SetSuccess()
  728.                   return
  729.                else
  730.                   GetUserPswd()
  731.                   if success
  732.                      strfmt tmp2 "%s;%s;%s" last first passwrd
  733.                   endif
  734.                   tries++
  735.                endif
  736.             endwhile
  737.             HostPutS("`r`n`r`nPassword incorrect.`r`n")
  738.             if connect_type==MODEM_CON
  739.                HostHangup()
  740.             endif
  741.             HostLog(name, "failed password check.")
  742.             SetFailure()
  743.             return
  744.          endif
  745.       endwhile
  746.       fclose 1
  747.       if system_type==CLOSED_SYSTEM
  748.          HostPutS("`r`nSorry, this is a closed system.`r`n")
  749.          if connect_type==MODEM_CON
  750.             HostHangup();
  751.          endif
  752.          HostLog(name, "attempted to login to closed system.")
  753.          SetFailure()
  754.          return
  755.       endif
  756.       AddUser()
  757.       return
  758.    else
  759.       HostMsgBox("FATAL ERROR - Can't open HOST.USR file!")
  760.    endif
  761.    SetFailure()
  762. endproc
  763.  
  764. ;***********************************************************************
  765. ;*                                                                     *
  766. ;*  COPYSFLD                                                           *
  767. ;*                                                                     *
  768. ;*  This procedure will copy a string field (SFLD) from any position   *
  769. ;*  within the source string, to the destination string.  Also, it     *
  770. ;*  will increment the index by the length of the field copied.        *
  771. ;*                                                                     *
  772. ;* Calls: NONE                                                         *
  773. ;*                                                                     *
  774. ;* Modifies globals: none                                              *
  775. ;*                                                                     *
  776. ;* NOTES:                                                              *
  777. ;* Input:  (&destination,source,&index,field_separator)                *
  778. ;*                                                                     *
  779. ;* Return:  destination and int are updated.                           *
  780. ;*                                                                     *
  781. ;* Notes:  Terminates when a field_separator or line feed is           *
  782. ;*         encountered. If neither is encountered, the rest of the     *
  783. ;*          field is copied.                                           *
  784. ;*                                                                     *
  785. ;***********************************************************************
  786. proc CopySFld
  787. strparm dst
  788. strparm src
  789. intparm index
  790. intparm fldsep
  791. integer newidx
  792. string endstr,tmp
  793.  
  794.    substr endstr src index 79          ; copy end of string to local var
  795.    strfmt tmp "%c" fldsep              ; tmp = field separator as a string
  796.    strfind endstr tmp newidx           ; see if a separator is in the string
  797.    if not found                        ; If separator not found:
  798.       strfind endstr "\n" newidx       ;   is a line feed in the string?
  799.       if not found                     ; If not:
  800.          strlen endstr newidx          ;   use the whole string
  801.       endif
  802.    endif
  803.    strcpy dst endstr newidx            ; copy field
  804.    index = index + newidx + 1          ; set caller's index
  805. endproc
  806.  
  807. ;***********************************************************************
  808. ;*                                                                     *   
  809. ;* HOSTHANGUP                                                          *
  810. ;*                                                                     *
  811. ;* This procedure attempts to hangup the line several times.           *
  812. ;*                                                                     *
  813. ;*                                                                     * 
  814. ;* Calls: HOSTPUTS, TXWAIT                                             *
  815. ;*                                                                     *
  816. ;* Modifies globals: none                                              *
  817. ;*                                                                     *
  818. ;***********************************************************************
  819. proc HostHangup
  820. integer hanguptries=3
  821.  
  822.    while $TXCOUNT>0        ; wait for tx buffer to clear
  823.    endwhile
  824.    if not $carrier
  825.       return
  826.    endif
  827.    while hanguptries--
  828.       pause 1
  829.       hangup
  830.       if not $carrier
  831.          exitwhile
  832.       endif
  833.    endwhile
  834.    if $carrier
  835.       HostPutS ("`r`nERROR: Unable to hangup.`r`n")
  836.    endif
  837. endproc
  838.  
  839. ;***********************************************************************
  840. ;*                                                                     *   
  841. ;* SETFAILURE                                                          *
  842. ;*                                                                     *
  843. ;* This procedure sets the IF FAILURE flag to TRUE.                    *
  844. ;*                                                                     *
  845. ;*                                                                     * 
  846. ;* Calls: NONE                                                         *
  847. ;*                                                                     *
  848. ;* Modifies globals: none                                              *
  849. ;*                                                                     *
  850. ;***********************************************************************
  851. proc SetFailure
  852.    strcmp "X" "Y"                      ; compare is always FALSE
  853. endproc
  854.  
  855. ;***********************************************************************
  856. ;*                                                                     *   
  857. ;* SETSUCCESS                                                          *
  858. ;*                                                                     *
  859. ;* This procedure sets the IF SUCCESS flag to TRUE.                    *
  860. ;*                                                                     *
  861. ;*                                                                     * 
  862. ;* Calls: NONE                                                         *
  863. ;*                                                                     *
  864. ;* Modifies globals: none                                              *
  865. ;*                                                                     *
  866. ;***********************************************************************
  867. proc SetSuccess
  868.    strcmp "X" "X"                       ; compare is always TRUE
  869. endproc
  870.  
  871. ;***********************************************************************
  872. ;*                                                                     *   
  873. ;* XKEYGET                                                             *
  874. ;*                                                                     *
  875. ;* This procedure processes local keystrokes.                          *
  876. ;*                                                                     *
  877. ;*                                                                     * 
  878. ;* Calls: EXITHOST, HOSTHANGUP                                         *
  879. ;*                                                                     *
  880. ;* Modifies globals: none                                              *
  881. ;*                                                                     *
  882. ;***********************************************************************
  883. proc xkeyget
  884. intparm key
  885. integer real_key
  886.    
  887.    keyget key              ; get the key value
  888.    switch key
  889.       
  890.       case 0x409           ; ALT-TAB   ;  these special keys must be
  891.       case 0x14            ; CAPS LOCK ;  must be passed to the
  892.       case 0x890           ; NUM LOCK  ;  main window to be recognized
  893.          termkey key
  894.          key=0x00
  895.       endcase
  896.  
  897.       case 0x458           ; E&xit Host
  898.       case 0x558
  899.          ExitHost()
  900.       endcase
  901.  
  902.       case 0x444
  903.       case 0x544           ; &Disconnect User
  904.          HostHangup()
  905.          longjmp 1 1
  906.       endcase
  907.  
  908.       case 0x452
  909.       case 0x552
  910.          longjmp 1 1       ; &Recycle host
  911.       endcase
  912.  
  913.       default
  914.          keytoascii key real_key    ; convert virtual key into
  915.          key=real_key               ; ASCII value for return
  916.       endcase
  917.    endswitch
  918. endproc
  919.  
  920. ;***********************************************************************
  921. ;*                                                                     *   
  922. ;* GETNEWPSWD                                                          *
  923. ;*                                                                     *
  924. ;* This procedure gets the password for a new user.                    *
  925. ;*                                                                     *
  926. ;*                                                                     * 
  927. ;* Calls: HOSTPUTS, HOSTGETS, SETSUCCESS, HOSTHANGUP, HOSTLOG,         *
  928. ;*        SETFAILURE                                                   *
  929. ;*                                                                     *
  930. ;* Modifies globals: passwrd, connect_type, name                       *
  931. ;*                                                                     *
  932. ;***********************************************************************
  933. proc GetNewPswd
  934.  
  935. integer i, tries
  936. string newpswd
  937.  
  938.    tries = 0
  939.    HostPutS("`r`n")
  940.    while tries < 3
  941.       HostPutS("`r`nPlease verify: ")
  942.       HostGetS(&newpswd, PSWDMAX, MASK)    ; Get passwrd
  943.       if not success
  944.          exitwhile
  945.       endif
  946.       strlen passwrd i
  947.       if i > 0
  948.          strupr passwrd
  949.          strupr newpswd
  950.          strcmp passwrd newpswd
  951.          if success
  952.             SetSuccess()
  953.             return
  954.          endif
  955.       endif
  956.       tries++
  957.    endwhile
  958.    if connect_type==MODEM_CON
  959.       HostHangup()
  960.    endif
  961.    HostLog(name, "failed to verify password.")
  962.    SetFailure()
  963. endproc
  964.  
  965. ;***********************************************************************
  966. ;*                                                                     *   
  967. ;* ADDUSER                                                             *
  968. ;*                                                                     *
  969. ;* This procedure adds a new user the the HOST.USR file.               *
  970. ;*                                                                     * 
  971. ;* Calls: GETNEWPSWD, HOSTMSGBOX, DISPLAYFILE, HOSTLOG, SETSUCCESS,    *
  972. ;*        SETFAILURE                                                   *
  973. ;*                                                                     *
  974. ;* Modifies globals: usrfile, record, last, first, passwrd,            *
  975. ;*                   new_usr_level, access_level, name                 *
  976. ;*                                                                     *
  977. ;***********************************************************************
  978. proc AddUser
  979.  
  980.    GetNewPswd()
  981.    if success
  982.       isfile usrfile
  983.       if not success
  984.          fopen 1 usrfile CREATE TEXT
  985.          if not success
  986.             HostMsgBox("FATAL ERROR - Can't create HOST.USR file!")
  987.             halt
  988.          endif
  989.       else
  990.          fopen 1 usrfile WRITE TEXT
  991.          if not success
  992.             HostMsgBox("Can't open HOST.USR file!")
  993.             halt
  994.          endif
  995.          fseek 1 0 2   ; go to end of file
  996.       endif
  997.       strfmt record "%s;%s;%s;%i;* NEW USER *" last first passwrd new_usr_level
  998.       itoa new_usr_level access_level
  999.       fputs 1 record
  1000.  
  1001.       if not success
  1002.          HostMsgBox("Didn't write user info! - Proc AddUser")
  1003.       endif
  1004.  
  1005.       fclose 1
  1006.       DisplayFile(nufile, 23)
  1007.       HostLog(name, "first login - added to user file.")
  1008.       SetSuccess()
  1009.       return
  1010.    endif
  1011.    SetFailure()
  1012. endproc
  1013.  
  1014. ;***********************************************************************
  1015. ;*                                                                     *   
  1016. ;* CHECKMENU                                                           *
  1017. ;*                                                                     *
  1018. ;* This procedure processes menu selections made with the mouse.       *
  1019. ;*                                                                     *
  1020. ;*                                                                     * 
  1021. ;* Calls: HOSTHANGUP, EXITHOST                                         *
  1022. ;*                                                                     *
  1023. ;* Called by: WHEN MENU command                                        *
  1024. ;*                                                                     *
  1025. ;* Modifies globals: status                                            *
  1026. ;*                                                                     *
  1027. ;***********************************************************************
  1028. proc CheckMenu
  1029.  
  1030.    status=$MENU
  1031.    switch status
  1032.       case 2               ; 2 is &Disconnect remote
  1033.          HostHangup()
  1034.          longjmp 1 1
  1035.       endcase
  1036.       case 3
  1037.          longjmp 1 1       ; 3 &Recycle host
  1038.       endcase
  1039.       case 4
  1040.          ExitHost()
  1041.       endcase
  1042.    endswitch
  1043. endproc
  1044.  
  1045. ;***********************************************************************
  1046. ;*                                                                     *   
  1047. ;* EXITHOST                                                            *
  1048. ;*                                                                     *
  1049. ;* This procedure allows safe shutdown of Host Mode script.            *
  1050. ;*                                                                     *
  1051. ;*                                                                     * 
  1052. ;* Calls: HOSTHANGUP, HOSTMSGBOX, HOSTLOG, RESTORE_PRM                 *
  1053. ;*                                                                     *
  1054. ;* Modifies globals: connect_type, action_status, meta_status,         *
  1055. ;*                   dial_status,  setup_status                        *
  1056. ;*                                                                     *
  1057. ;***********************************************************************
  1058. proc ExitHost
  1059. string auto_ans_off
  1060. integer response
  1061.  
  1062.    if (connect_type==MODEM_CON) || (local_logon==TRUE)
  1063.  
  1064.       rxflush
  1065.       txflush
  1066.       transmit "^M"
  1067.       statmsg "Closing Host Mode ..." BEEP
  1068.       set txpace 50
  1069.       if $CARRIER
  1070.          sdlgmsgbox "Host Message" "Hangup Line?" QUESTION YESNO response 2 BEEP
  1071.          if response==6
  1072.             HostHangup()
  1073.             fetch modem autoansoff auto_ans_off
  1074.             pause 1
  1075.             transmit auto_ans_off
  1076.             waitfor "OK" 8
  1077.          endif
  1078.       else
  1079.          fetch modem autoansoff auto_ans_off
  1080.          pause 1
  1081.          transmit auto_ans_off
  1082.          waitfor "OK" 8
  1083.       endif
  1084.    endif
  1085.    HostMsgBox("Host Mode aborted")
  1086.    HostLog("Host mode offline.", "")
  1087.    restore_prm()
  1088.    if action_status
  1089.       actionbar on
  1090.    endif
  1091.    if meta_status
  1092.       metakeys on
  1093.    endif
  1094.    if dial_status
  1095.       dialdir on
  1096.    endif
  1097.    if setup_status
  1098.       setup on
  1099.    endif
  1100.    statmsg " "
  1101.    pwtitlebar "PROCOMM PLUS for Windows"
  1102.    clear
  1103.    halt
  1104. endproc
  1105.  
  1106. ;***********************************************************************
  1107. ;*                                                                     *   
  1108. ;* DISPLAYFILE                                                         *
  1109. ;*                                                                     *
  1110. ;* This procedure sends an ASCII file to the remote user with paging.  *
  1111. ;*                                                                     *
  1112. ;*                                                                     * 
  1113. ;* Calls: SETFAILURE, HOSTPUTS, HOSTGETC, SETSUCCESS                   *
  1114. ;*                                                                     *
  1115. ;* Modifies globals: none                                              *
  1116. ;*                                                                     *
  1117. ;***********************************************************************
  1118. proc DisplayFile
  1119. strparm _file              ; file to transmit
  1120. intparm page_length        ; how many lines before -MORE- prompt
  1121. string line, response
  1122. integer count=0
  1123.  
  1124.    isfile _file            ; check for the file
  1125.    if not success          ; if it doesn't exist
  1126.       SetFailure()         ; return
  1127.       return
  1128.    endif
  1129.    fopen 5 _file READ      ; open the file
  1130.    while 1                 ; loop forever
  1131.       fgets 5 line         ; get a line
  1132.       if FEOF 5            ; check for EOF
  1133.          exitwhile
  1134.       endif
  1135.       HostPutS(line)          ; display line
  1136.       inc count               ; increment line counter
  1137.       if count==page_length   ; if count == page length display a prompt
  1138.          HostPutS("-MORE-")
  1139.          HostGetC(&response)  ; get user input
  1140.          HostPutS("`b`b`b`b`b`b")
  1141.          strupr response
  1142.          strcmp response "N"  ; if the user says NO then
  1143.          if success
  1144.             exitwhile
  1145.          endif
  1146.          count=1              ; reset line counter
  1147.       endif
  1148.    endwhile
  1149.    fclose 5                  ; close the file
  1150.    SetSuccess()
  1151. endproc
  1152.  
  1153. ;***********************************************************************
  1154. ;*                                                                     *   
  1155. ;* HOSTMSGBOX                                                          *
  1156. ;*                                                                     *
  1157. ;* This procedure displays a dialog box with an error message for      *
  1158. ;* 3 seconds.                                                          *
  1159. ;*                                                                     * 
  1160. ;* Calls: NONE                                                         *
  1161. ;*                                                                     *
  1162. ;* Modifies globals: message                                           *
  1163. ;*                                                                     *
  1164. ;***********************************************************************
  1165. proc HostMsgBox
  1166. strparm _message
  1167.  
  1168.    beep
  1169.    mspause 500
  1170.    beep
  1171.    mspause 500
  1172.    dialogbox 48 20 174 65 15 "Host Mode Message"
  1173.       vtext 1 16 167 26 center message
  1174.    enddialog
  1175.    message=_message
  1176.    updatedlg -1
  1177.    pause 3
  1178.    destroydlg
  1179. endproc
  1180.  
  1181. ;***********************************************************************
  1182. ;*                                                                     *   
  1183. ;* CHAT                                                                *
  1184. ;*                                                                     *
  1185. ;* This procedure allows the sysop and a remote user to converse       *
  1186. ;* online.                                                             *
  1187. ;*                                                                     *
  1188. ;*                                                                     * 
  1189. ;* Calls: HOSTPUTS, HOSTGETC, SETFAILURE                               *
  1190. ;*                                                                     *
  1191. ;* Modifies globals: msg, name, status                                 *
  1192. ;*                                                                     *
  1193. ;***********************************************************************
  1194. proc Chat
  1195. string c
  1196. long timer
  1197.  
  1198.    HostPutS("`r`nPaging Host Operator ...`r`n")
  1199.    strfmt msg "Remote user %s is requesting to chat." name
  1200.    dialogbox 26 22 200 67 13
  1201.       pushbutton 59 38 76 14 "OK" normal default
  1202.       vtext 9 13 178 9 center msg
  1203.    enddialog
  1204.    status=$DIALOG
  1205.    alarm
  1206.    alarm
  1207.    timer=$LTIME
  1208.    while ($LTIME < (timer+8))
  1209.       if status==10
  1210.          destroydlg
  1211.          HostPutS("`r`nHost Operator is online!`r`n`r`n")
  1212.          HostPutS("Press ESC to end chat.`r`n`r`n")
  1213.          while 1
  1214.             HostGetC(&c)
  1215.             if failure
  1216.                SetFailure()
  1217.                return
  1218.             endif
  1219.             switch c
  1220.                case "`r"
  1221.                   strcat c "`n"
  1222.                endcase
  1223.  
  1224.                case "`x1b"
  1225.                   return
  1226.                endcase
  1227.             endswitch
  1228.             transmit c
  1229.             termwrites c
  1230.          endwhile
  1231.       endif
  1232.       status=$DIALOG
  1233.    endwhile
  1234.    destroydlg
  1235.    HostPutS("`r`nHost Operator is not available!`r`n")
  1236. endproc
  1237.  
  1238. ;***********************************************************************
  1239. ;*                                                                     *   
  1240. ;* COUNTMSG                                                            *
  1241. ;*                                                                     *
  1242. ;* This procedure counts the number of mail messages.                  *
  1243. ;*                                                                     *
  1244. ;*                                                                     * 
  1245. ;* Calls: HOSTMSGBOX, EXITHOST                                         *
  1246. ;*                                                                     *
  1247. ;* Modifies globals: hdrfile                                           *
  1248. ;*                                                                     *
  1249. ;***********************************************************************
  1250. proc CountMsg
  1251. intparm number
  1252.  
  1253. integer dummy
  1254. string msg_entry
  1255.  
  1256.    number=0                         ; start with 0 messages
  1257.  
  1258.    isfile hdrfile                   ; is HOST.HDR present
  1259.    if not success                   ; if not return
  1260.       return
  1261.    endif
  1262.     
  1263.    fopen 4 hdrfile READ             ; open HOST.HDR
  1264.    if not success                   ; error opening the file
  1265.       HostMsgBox("FATAL ERROR - Can't open HOST.HDR file!")
  1266.       ExitHost()                    ; exit script
  1267.    endif
  1268.    while 1                          ; loop forever
  1269.       fread 4 msg_entry 128 dummy   ; read 1 message entry
  1270.       if FEOF 4                     ; if EOF, close file and return
  1271.          fclose 4
  1272.          return
  1273.       endif
  1274.       inc number                    ; otherwise add 1 to message count
  1275.    endwhile
  1276. endproc
  1277.  
  1278. ;***********************************************************************
  1279. ;*                                                                     *   
  1280. ;* MAILGETLINE                                                         *
  1281. ;*                                                                     *
  1282. ;* This procedure accepts a string from the user for entering mail.    *
  1283. ;*                                                                     *
  1284. ;*                                                                     * 
  1285. ;* Calls: HOSTGETC, SETSUCCESS, HOSTPUTS                               *
  1286. ;*                                                                     *
  1287. ;* Modifies globals: none                                              *
  1288. ;*                                                                     *
  1289. ;***********************************************************************
  1290. proc MailGetLine
  1291. strparm s
  1292. integer max=70
  1293. integer i
  1294. string response
  1295.  
  1296.    strpoke s 0 0
  1297.    i = 0
  1298.    while 1
  1299.       HostGetC(&response)
  1300.       if not success
  1301.          exitwhile
  1302.       endif
  1303.       switch response
  1304.          case "`r"
  1305.             SetSuccess()
  1306.             exitwhile
  1307.             endcase
  1308.          case "`b"
  1309.             if i != 0
  1310.                HostPutS(response)
  1311.                i--
  1312.                strpoke s i 0
  1313.             endif
  1314.             endcase
  1315.          case " "                   ; This SPACE case must immediately
  1316.             if i>55                 ; precede the DEFAULT so it will
  1317.                i=max                ; fall through
  1318.             endif                   ; do wordwrap stuff here!!!
  1319.          default
  1320.             if i == max
  1321.                HostPutS(response)
  1322.                strcat s response
  1323.                SetSuccess()
  1324.                exitwhile
  1325.             else
  1326.                HostPutS(response)
  1327.                strcat s response
  1328.                i++
  1329.             endif
  1330.          endcase
  1331.       endswitch
  1332.    endwhile
  1333. endproc
  1334.  
  1335. ;***********************************************************************
  1336. ;*                                                                     *   
  1337. ;* CHECKMAIL                                                           *
  1338. ;*                                                                     *
  1339. ;* This procedure notifies a user that there is new mail waiting.      *
  1340. ;*                                                                     *
  1341. ;*                                                                     * 
  1342. ;* Calls: HOSTPUTS                                                     *
  1343. ;*                                                                     *
  1344. ;* Modifies globals: hdrfile, _date, _time, name                       *
  1345. ;*                                                                     *
  1346. ;***********************************************************************
  1347. proc CheckMail
  1348. integer msg_num, msg_length, msg_flag, dummy
  1349. string destination, from, subject
  1350. long offset
  1351.  
  1352.    isfile hdrfile                ; is HOST.HDR present
  1353.    if not success                ; if not return
  1354.       return
  1355.    endif
  1356.  
  1357.    fopen 0 hdrfile READ          ; open HOST.HDR for read only
  1358.    if not success                ; error opening file
  1359.       return
  1360.    endif
  1361.    while 1                       ; loop forever
  1362.       fgeti 0 msg_num            ; get the message number
  1363.       if FEOF 0                  ; if EOF exit the while loop
  1364.          exitwhile
  1365.       endif
  1366.       fgetl 0 offset             ; get message file offset
  1367.       fgeti 0 msg_length         ; get length of message
  1368.       fgetc 0 msg_flag           ; get message flag
  1369.       fread 0 destination 31 dummy     ; get TO:
  1370.       fread 0 from 31 dummy            ; get FROM:
  1371.       fread 0 subject 37 dummy         ; get subject
  1372.       fread 0 _date 9 dummy            ; get message date
  1373.       fread 0 _time 11 dummy           ; get message time
  1374.       strcmp destination name          ; compare message TO: and user name
  1375.       if success                       ; if this is there message
  1376.          if (msg_flag & 2)==NEWMAIL    ; check to see if NEWMAIL flag is set
  1377.             HostPutS("`r`n`aYou have mail waiting!`r`n`r`n")
  1378.             exitwhile                  ; leave the while loop
  1379.          endif
  1380.       endif
  1381.    endwhile
  1382.    fclose 0                            ; close HOST.HDR
  1383. endproc
  1384.  
  1385. ;***********************************************************************
  1386. ;*                                                                     *   
  1387. ;* CHANGEFLAG                                                          *
  1388. ;*                                                                     *
  1389. ;* This procedure modifies the flag byte for a message.                *
  1390. ;*                                                                     *
  1391. ;*                                                                     * 
  1392. ;* Calls: NONE                                                         *
  1393. ;*                                                                     *
  1394. ;* Modifies globals: hdrfile, msg_number                               *
  1395. ;*                                                                     *
  1396. ;***********************************************************************
  1397. proc ChangeFlag
  1398. intparm flagbyte
  1399. long hdr_offset
  1400.  
  1401.    fopen 0 hdrfile WRITE               ; open HOST.HDR as write only
  1402.    if not success                      ; error opening file
  1403.       return
  1404.    endif
  1405.    hdr_offset=((msg_number-1)*128)+8
  1406.    fseek 0 hdr_offset 0                ; seek to flag byte of current message
  1407.    fputc 0 flagbyte                    ; write the passed parameter
  1408.    fclose 0                            ; close HOST.HDR
  1409. endproc
  1410.  
  1411. ;***********************************************************************
  1412. ;*                                                                     *   
  1413. ;* DELETEMSG                                                           *
  1414. ;*                                                                     *
  1415. ;* This procedure marks a mial message for deletion.                   *
  1416. ;*                                                                     *
  1417. ;*                                                                     * 
  1418. ;* Calls: HOSTMSGBOX,   HOSTPUTS,     CHANGEFLAG                       *
  1419. ;*                                                                     *
  1420. ;* Modifies globals: hdrfile, msg_number, _date, _time, name,          *
  1421. ;*                   access_level                                      *
  1422. ;*                                                                     *
  1423. ;***********************************************************************
  1424. proc DeleteMsg
  1425. integer msg_num, msg_length, msg_flag, dummy
  1426. long offset, hdr_offset
  1427. string destination, from, subject
  1428.     
  1429.    isfile hdrfile
  1430.    if not success
  1431.       return
  1432.    endif
  1433.  
  1434.    fopen 0 hdrfile READ
  1435.    if not success
  1436.       HostMsgBox("Can't open HDRFILE - Proc DeleteMsg")
  1437.       return
  1438.    endif
  1439.  
  1440.    hdr_offset=(msg_number-1)*128
  1441.    fseek 0 hdr_offset 0
  1442.  
  1443.    fgeti 0 msg_num
  1444.    if FEOF 0
  1445.       fclose 0
  1446.       return
  1447.    endif
  1448.    fgetl 0 offset                   ; get message file offset
  1449.    fgeti 0 msg_length               ; get length of message
  1450.    fgetc 0 msg_flag                 ; get message flag
  1451.    fread 0 destination 31 dummy     ; get TO:
  1452.    fread 0 from 31 dummy            ; get FROM:
  1453.    fread 0 subject 37 dummy         ; get subject
  1454.    fread 0 _date 9 dummy            ; get message date
  1455.    fread 0 _time 11 dummy           ; get message time
  1456.    strcmp destination name          ; compare message TO: and user name
  1457.    if not success
  1458.       strcmp from name              ; compare message FROM: and user name
  1459.       if not success
  1460.          strcmp access_level "2"    ; is this user a level 2 security
  1461.          if not success             ; if not send message and return
  1462.             HostPutS("`r`nYou can't delete this message.`r`n")
  1463.             return
  1464.          endif
  1465.       endif
  1466.    endif
  1467.    fclose 0                         ; close HOST.HDR
  1468.    msg_flag=msg_flag+4              ; add DELETED flag to the flag byte
  1469.    ChangeFlag(msg_flag)             ; pass new message flag to ChangeFlag
  1470.    HostPutS("`r`nMessage has been marked for deletion.`r`n`r`n")
  1471. endproc
  1472.  
  1473. ;***********************************************************************
  1474. ;*                                                                     *   
  1475. ;* TXWAIT                                                              *
  1476. ;*                                                                     *
  1477. ;* This procedure waits for the TX buffer to empty before returning.   *
  1478. ;*                                                                     *
  1479. ;*                                                                     * 
  1480. ;* Calls: NONE                                                         *
  1481. ;*                                                                     *
  1482. ;* Modifies globals: none                                              *
  1483. ;*                                                                     *
  1484. ;***********************************************************************
  1485. proc txwait
  1486.    while $TXCOUNT>0
  1487.    endwhile
  1488.    pause 3
  1489. endproc
  1490. ;**** End of SUBS.WAS ****
  1491.